home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 221 / pascal / fplot3.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-17  |  3.0 KB  |  156 lines
  1. PROGRAM fplot;
  2.  
  3.   CONST
  4.     pi = 3.14159;
  5.     {$I gemconst.pas}
  6.  
  7.   TYPE
  8.     {$I gemtype.pas}
  9.  
  10.   VAR
  11.     phi,theta : real;
  12.     x,y,z : real;
  13.     scalex,scaley,scalez : real;
  14.     event,
  15.     which,
  16.     dummy,
  17.     handle,
  18.     wind_type : integer ;
  19.     title : Window_Title ;
  20.     c0,r0 : integer;
  21.     msg : message_buffer;
  22.  
  23.   {$I gemsubs.pas}
  24.  
  25. procedure f ( var x,y,z : real);
  26.  
  27. begin
  28.   y := sin(2*pi*sqrt(x*x+z*z))/6;   {calculate y from x,z}
  29. end;
  30.  
  31. procedure draw_f;     {draw function on screen}
  32.  
  33. var
  34.   f : string[255];
  35.  
  36. begin
  37.   line_color(2);
  38.   f := 'y := sin(2*pi*sqrt(x*x+z*z))/6;';
  39.   draw_string(c0-3*length(f),195,f);
  40.   draw_string(20,20,'Programmed by G. F. Sellars');
  41.   draw_string(20,30,' with Oss Personal Pascal');
  42. end;
  43.  
  44. procedure project(x,y,z : real; var c,r : integer); {3d to 2d}
  45.  
  46. var
  47.   d : real;
  48.  
  49. begin
  50.   d := scalez*z;
  51.   c := round(scalex*(x+d))+c0;
  52.   r := round(scaley*(y+d))+r0;
  53. end;
  54.  
  55. PROCEDURE plot_curve;
  56.  
  57. var
  58.   c,r : integer;
  59.  
  60. begin
  61.   z := -1;                        {plot lines parallel to x axis}
  62.   while z <= 1 do begin
  63.     x := -1;
  64.     f(x,y,z);
  65.     project(x,y,z,c,r);
  66.     move_to(c,r);
  67.     while x <= 1 do begin
  68.       f(x,y,z);
  69.       project(x,y,z,c,r);
  70.       line_to(c,r);
  71.       x := x + 0.05;
  72.     end;
  73.     z := z + 0.05;
  74.   end;
  75.   x := -1;                        {plot lines parallel to z axis}
  76.   while x <= 1 do begin
  77.     z := -1;
  78.     f(x,y,z);
  79.     project(x,y,z,c,r);
  80.     move_to(c,r);
  81.     while z <= 1 do begin
  82.       f(x,y,z);
  83.       project(x,y,z,c,r);
  84.       line_to(c,r);
  85.       z := z + 0.05;
  86.     end;
  87.     x := x + 0.05;
  88.   end;
  89. END;
  90.  
  91. procedure axis(x0,y0,z0,x1,y1,z1 :real; name : char); {draw x,y, or z axis}
  92.  
  93. var
  94.   c,r : integer;
  95.  
  96. begin
  97.   project(x0,y0,z0,c,r);
  98.   move_to(c,r);
  99.   project(x1,y1,z1,c,r);
  100.   line_to(c,r);
  101.   project(1.1*x1,1.1*y1,1.1*z1,c,r);
  102.   draw_string(c,r,name);
  103. end;
  104.  
  105. procedure init;
  106.  
  107. var
  108.   i,c,r,w,h: integer;
  109.   wr,hr : real;
  110.  
  111. begin
  112.   handle := New_Window(0,title,0,0,0,0);
  113.   Open_Window(handle,0,0,0,0);
  114.   Work_Rect(handle,c,r,w,h);
  115.   Set_Clip(c,r,w,h);
  116.   Paint_Style(Solid);
  117.   Paint_Color(White);
  118.   Paint_Rect(c,r,w,h);
  119.   c0 := (w-c) div 2;                    {c0,r0 = center of screen}
  120.   r0 := (h-r) div 2;
  121.   r0 := r0+16;
  122.   wr := w-c; hr := h-r;
  123.   scalex := wr/4;
  124.   scaley := -hr/2.5;
  125.   scalez := -1/2;
  126.   Line_Color(2);
  127.   text_color(2);
  128.   axis(-1,0,0,1,0,0,'x');
  129.   axis(0,-1,0,0,1,0,'y');
  130.   axis(0,0,-2,0,0,2,'z');
  131.   Line_Color(1);
  132. end;
  133.  
  134. BEGIN
  135.   IF Init_Gem >= 0 THEN BEGIN
  136.     Hide_Mouse ;
  137.     Begin_Update ;
  138.     init;
  139.     plot_curve;
  140.     draw_f;
  141.     End_Update ;
  142.     write(chr(7));
  143.     repeat
  144.       event := get_event(e_button | e_timer,1,1,1,
  145.                        10,
  146.                        false,0,0,0,0,
  147.                        false,0,0,0,0,
  148.                        msg,dummy,dummy,dummy,dummy,dummy,dummy);
  149.     until event & e_button <> 0; {until left mouse button clicked once}
  150.     Show_Mouse ;
  151.     Close_Window( handle ) ;
  152.     Delete_Window( handle ) ;
  153.   END;
  154.   Exit_Gem ;
  155. END.
  156.